'Black Scholes Function Defs v.1.0

'(c) 2006 www.geocities.com/gbosmis

'1. norm - pdf of the normal variable
'2. snorm - cummulative probability function of a normal variable
'3. call_eur - the value of a call (european type)
'- s price
'- x strike
'- t time to expiry (years)
'- r interest rate
'- sd volatility
'- q dividend yield
'4. put_eur - the value of a put
'5. call_delta_eur - the delta of a call
'6. put_delta_eur - the delta of a put
'7. gamma_eur - the gamma of an option
'8. vega_eur - the vega of an option
'- multiply *0.01 to get the vega per 1% change of volatility
'9. call_theta_eur - the theta of a call
'- multiply *(1/252) to get the theta per trading day
'10. put_theta_eur - the theta of a put
'11. call_rho_eur - the rho of a call
'- multiply * 0.01 to get the rho per 1% interest rate change
'12. put_rho_eur - the rho of a put
'13. call_impvol_eur - the implied volatility of a call
'- p the call value
'14. put_impvol_eur - the implied volatility of a put


Global Const pi = 3.14159265358979

'normal distribution function
Private Function norm(z As Double) As Double
norm = 1 / Sqr(2 * pi) * Exp(-z ^ 2 / 2)
End Function

'cumulative normal distribution function
Private Function snorm(z As Double) As Double
    Const a1 = 0.31938153
    Const a2 = -0.356563782
    Const a3 = 1.781477937
    Const a4 = -1.821255978
    Const a5 = 1.330274429
If z < 0 Then w = -1 Else w = 1
k = 1 / (1 + 0.2316419 * w * z)
snorm = 0.5 + w * (0.5 - 1 / Sqr(2 * pi) * Exp(-z ^ 2 / 2) * (a1 * k + a2 * k ^ 2 + a3 * k ^ 3 + a4 * k ^ 4 + a5 * k ^ 5))
End Function

Function call_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    Dim d2 As Double
    If t > 0 Then
        d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
        d2 = d1 - sd * (t ^ 0.5)
        call_eur = s * Exp(-q * t) * snorm(d1) - x * Exp(-r * t) * snorm(d2)
    Else
        If s > x Then
            call_eur = s - x
        Else
            call_eur = 0
        End If
    End If
End Function

Function put_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    Dim d2 As Double
    If t > 0 Then
        d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
        d2 = d1 - sd * (t ^ 0.5)
        put_eur = -s * Exp(-q * t) * snorm(-d1) + x * Exp(-r * t) * snorm(-d2)
    Else
        If s < x Then
            put_eur = x - s
        Else
            put_eur = 0
        End If
    End If
End Function

Function call_delta_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    call_delta_eur = Exp(-q * t) * snorm(d1)
End Function

Function put_delta_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    put_delta_eur = Exp(-q * t) * (snorm(d1) - 1)
End Function

Function gamma_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    gamma_eur = Exp(-q * t) * norm(d1) / (s * sd * Sqr(t))
End Function

Function vega_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    vega_eur = Exp(-q * t) * s * Sqr(t) * norm(d1)
End Function

Function call_theta_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    Dim d2 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    d2 = d1 - sd * (t ^ 0.5)
    call_theta_eur = -s * Exp(-q * t) * norm(d1) * sd / (2 * Sqr(t)) _
    + q * s * Exp(-q * t) * snorm(d1) - r * x * Exp(-r * t) * snorm(d2)
End Function

Function put_theta_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    Dim d2 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    d2 = d1 - sd * (t ^ 0.5)
    put_theta_eur = -s * Exp(-q * t) * norm(d1) * sd / (2 * Sqr(t)) _
    - q * s * Exp(-q * t) * snorm(-d1) + r * x * Exp(-r * t) * snorm(-d2)
End Function

Function call_rho_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    Dim d2 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    d2 = d1 - sd * (t ^ 0.5)
    call_rho_eur = x * t * Exp(-r * t) * snorm(d2)
End Function

Function put_rho_eur(s As Double, x As Double, t As Double, r As Double, sd As Double, q As Double) As Double
    Dim d1 As Double
    Dim d2 As Double
    d1 = (Log(s / x) + (r - q + sd ^ 2 / 2) * t) / (sd * Sqr(t))
    d2 = d1 - sd * (t ^ 0.5)
    put_rho_eur = -x * t * Exp(-r * t) * snorm(-d2)
End Function

Function call_impvol_eur(s As Double, x As Double, t As Double, r As Double, p As Double, q As Double) As Double
    Dim d As Double
    Dim sd As Double
    Dim sdt As Double
    Dim i As Integer
    Dim k As Integer
    Dim v As Double
    sd = 0
Start:
    k = 0
    v = 1
    sd = sd + 1
    sdt = sd
    For i = 1 To 16
    v = v / 2
    d = p - call_eur(s, x, t, r, sd, q)
    If d > 0 Then
    k = k + 1
    sd = sd + v
    Else:
    sd = sd - v
    End If
    Next i
    If k = 16 Then
    GoTo Start:
    Else:
    If k = 0 Then sd = sdt - 1
    call_impvol_eur = sd
    End If
End Function

Function put_impvol_eur(s As Double, x As Double, t As Double, r As Double, p As Double, q As Double) As Double
    Dim d As Double
    Dim sd As Double
    Dim sdt As Double
    Dim i As Integer
    Dim k As Integer
    Dim v As Double
    sd = 0
Start:
    k = 0
    v = 1
    sd = sd + 1
    sdt = sd
    For i = 1 To 16
    v = v / 2
    d = p - put_eur(s, x, t, r, sd, q)
    If d > 0 Then
    k = k + 1
    sd = sd + v
    Else:
    sd = sd - v
    End If
    Next i
    If k = 16 Then
    GoTo Start:
    Else:
    If k = 0 Then sd = sdt - 1
    put_impvol_eur = sd
    End If
End Function
